home *** CD-ROM | disk | FTP | other *** search
/ Australian Personal Computer 2002 November / CD 1 / APC0211D1.ISO / workshop / prog / files / ActivePerl-5.6.1.633-MSWin32.msi / _cc35ee55e73f246b06549fa0a14b50b1 < prev    next >
Encoding:
Text File  |  2002-05-30  |  2.8 KB  |  95 lines
  1. # cscroll.pl
  2.  
  3. use subs qw/cscroll_button cscroll_enter cscroll_leave/;
  4. use vars qw/$TOP/;
  5.  
  6. sub cscroll {
  7.  
  8.     # Create a top-level window containing a simple canvas that can be
  9.     # scrolled in two dimensions.
  10.  
  11.     my($demo) = @_;
  12.     $TOP = $MW->WidgetDemo(
  13.         -name     => $demo,
  14.         -text     => 'This window displays a canvas widget that can be scrolled either using the scrollbars or by dragging with button 2 in the canvas.  If you click button 1 on one of the rectangles, its indices will be printed on stdout.',
  15.         -title    => 'Scrollable Canvas Demonstration',
  16.         -iconname => 'cscroll',
  17.     );
  18.  
  19.     my $c = $TOP->Scrolled(qw/Canvas -relief sunken -borderwidth 2
  20.         -scrollbars se -scrollregion/ => ['-10c', '-10c', '50c', '20c']);
  21.     $c->pack(qw/-expand yes -fill both/);
  22.  
  23.     my($bg, $i, $j, $x, $y) = ($c->configure(-background))[4];
  24.     for ($i = 0; $i < 20; $i++) {
  25.     $x = -10 + 3 * $i;
  26.     $j = 0;
  27.     $y = -10;
  28.     while ($j < 10) {
  29.         $c->create('rectangle', sprintf("%dc", $x), sprintf("%dc", $y),
  30.                sprintf("%dc", $x+2), sprintf("%dc", $y+2),
  31.                -outline => 'black', -fill => $bg, -tags => 'rect');
  32.         $c->create('text', sprintf("%dc", $x+1), sprintf("%dc", $y+1),
  33.                -text => "$i,$j", -anchor => 'center', -tags => 'text');
  34.         $j++;
  35.         $y += 3;
  36.     } # whilend
  37.     } # forend
  38.  
  39.     my $old_fill = '';
  40.     $c->bind('all', '<Any-Enter>' => [\&cscroll_enter, \$old_fill]);
  41.     $c->bind('all', '<Any-Leave>' => [\&cscroll_leave, \$old_fill]);
  42.     $c->bind('all', '<1>' => \&cscroll_button);
  43.  
  44.     $c->CanvasBind('<2>' => sub {
  45.     my ($c) = @_;
  46.         my $e = $c->XEvent;
  47.     $c->scan('mark', $e->x, $e->y);
  48.     });
  49.     $c->CanvasBind('<B2-Motion>' => sub {
  50.     my ($c) = @_;
  51.         my $e = $c->XEvent;
  52.     $c->scan('dragto', $e->x, $e->y);
  53.     });
  54.  
  55. } # end cscroll
  56.  
  57. sub cscroll_button {
  58.  
  59.     my($c) = @_;
  60.  
  61.     my $id = $c->find(qw/withtag current/);
  62.     $id++ if ($c->gettags('current'))[0] ne 'text';
  63.     print STDOUT 'You buttoned at ', ($c->itemconfigure($id, -text))[4], "\n";
  64.  
  65. } # end cscroll_button
  66.  
  67. sub cscroll_enter {
  68.  
  69.     my($c, $old_fill) = @_;
  70.  
  71.     my $id = $c->find(qw/withtag current/);
  72.     $id-- if ($c->gettags('current'))[0] eq 'text';
  73.     $$old_fill = ($c->itemconfigure($id, -fill))[4];
  74.     if ($c->depth > 1) {
  75.     $c->itemconfigure($id, -fill => 'SeaGreen1');
  76.     } else {
  77.     $c->itemconfigure($id, -fill => 'black');
  78.     $c->itemconfigure($id+1, -fill => 'white');
  79.     }
  80.  
  81. } # end cscroll_enter
  82.  
  83. sub cscroll_leave {
  84.  
  85.     my($c, $old_fill) = @_;
  86.  
  87.     my $id = $c->find(qw/withtag current/);
  88.     $id-- if ($c->gettags('current'))[0] eq 'text';
  89.     $c->itemconfigure($id, -fill => $$old_fill);
  90.     $c->itemconfigure($id+1, -fill => 'black');
  91.  
  92. } # end cscroll_leave
  93.  
  94. 1;
  95.